rm(list = ls())
setwd("~/Projects/news_tweets")
## --- Load Packages --- ##
library(rtweet)
library(dplyr)
library(ggplot2)
library(rvest)
library(tidyr)
library(wordcloud2)
library(igraph)
library(ggraph)
library(stringr)
library(tm)
library(tidytext)
library(stringi)
library(lubridate)
## --- Set Stylings --- ###
knitr::opts_chunk$set(message=FALSE, warning=FALSE)
theme_set(
theme_bw(base_size = 14) +
theme(
plot.title = element_text(face = "bold", size = 14,
margin = margin(0, 0, 4, 0, "pt")),
plot.subtitle = element_text(size = 12),
plot.caption = element_text(size = 6, hjust = 0),
axis.title = element_text(size = 10),
panel.border = element_blank()
)
)
## --- Global Variables --- ##
# Define Color
Mycol <- RColorBrewer::brewer.pal(8, "Dark2")
# Define http pattern
http <- paste("http.*","https.*", sep = "|")
# Define Stopwords
stopwords <- data_frame(
word = stopwords("german")
) %>% rbind(
data_frame(word = c("t.co","via","mal","dass","mehr", "amp","https",
"beim", "ab","sollen","ganz","sagt",
"schon","rt","gibt", "ja", "natürlich"))
)Deutschsprachige Tweets die den Hashtag “#GERSWE” beinhalten. Die Tweets wurden mit Hilfe des R Packetes rtweet über die REST API ausgelesen. Der gesamte Code ist hier einzusehen.
Folgende Variablen sind in unserem Datensatz vorhanden.
load("../../data/germex.Rda")
attr(rt$created_at, "tzone") <- "Europe/Berlin"
start <- as.POSIXct("2018-06-17 16:00", tz = "Europe/Berlin")
end <- start + minutes(220)
gamestart <- as.POSIXct("2018-06-17 17:00", tz = "Europe/Berlin")
gameend <- gamestart + minutes(112)
rt_small <- rt %>%
# mutate(created_at = as.POSIXct(created_at + hours(2))) %>%
filter(created_at >= start) %>%
filter(created_at <= end) rt_small %>%
ts_plot("1 minute",
color = Mycol[3]) +
geom_vline(xintercept = gamestart, color=Mycol[1], linetype = 2) +
geom_vline(xintercept = gameend, color=Mycol[1], linetype = 2) +
theme(plot.title = element_text(face = "bold"),
axis.text.x = element_blank()) +
labs(
x = NULL, y = NULL,
title = "Tweets zum Spiel Deutschland - Mexiko",
subtitle = paste("Zeitraum:",min(rt$created_at),"bis",max(rt$created_at))
) Welche Tweets wurden am häufigsten geteilt? Die top 10 sind:
rt_small %>%
filter(is_retweet == FALSE ) %>%
dplyr::select(screen_name, text, retweet_count) %>%
group_by(screen_name, text) %>%
summarise(retweet_count = sum(retweet_count)) %>%
arrange(desc(retweet_count)) %>%
.[1:10,] %>%
htmlTable::htmlTable(align="l")| screen_name | text | retweet_count | |
|---|---|---|---|
| 1 | DFB_Team | Schluss! #DieMannschaft verliert den WM-Auftakt gegen Mexiko. #GERMEX 0-1 #ZSMMN https://t.co/wE73FNLBrv | 1356 |
| 2 | ThatRexGuy | Joachim Löw when literally anything happens. #GERMEX #WorldCup https://t.co/5e0xQ9Q3Yy | 1172 |
| 3 | KuehniKev | Sportminister ist in #Deutschland übrigens Horst Seehofer. 🤷🏼♂️ #GERMEX | 906 |
| 4 | DerWachsame | Wir haben ein Fußballspiel verloren, das ist traurig, aber nicht schlimm. Morgen wird vielleicht ein durchgeknallter Innenminister im Alleingang die Grenzen schließen und die Regierung sprengen. DAS ist schlimm. #GERMEX | 801 |
| 5 | ghensel | Mal im Ernst. Rausfliegen in der Vorrunde passt doch bombe zu unserer masochistischen Gefühlslage gerade. Ich sehe schon die Talkshow-Themen vor mir: „Deutsches WM-Aus. Welche Rolle spielt der Islam?“ #GERMEX | 499 |
| 6 | DFB_Team | Seid ihr bereit für #GERMEX 🇩🇪🇲🇽? #ZSMMN #WM2018 #GERMEX https://t.co/POxvqBKDBj | 491 |
| 7 | DFB_Team | Auf geht’s, Männer!!! 🇩🇪🇲🇽 #ZSMMN #WM2018 #GERMEX 0-0 https://t.co/l13goZrece | 470 |
| 8 | DFB_Team | Halbzeit. Mund abputzen. Da geht noch was, Männer! #GERMEX 0-1 #DieMannschaft #ZSMMN https://t.co/0ZJu1R64iL | 443 |
| 9 | OomenBerlin |
Seit wir Nazis im Bundestag haben hat die #Nationalmannschaft noch kein WM-Spiel gewonnen. Denkt mal drüber nach. #GERMEX #WM2018 |
440 |
| 10 | FCBayern |
🇩🇪 Kopf hoch, Männer! #WeiterImmerWeiter #GERMEX #DieMannschaft #WM2018 https://t.co/CLHAah2jJo |
431 |
rt_clean <- rt_small %>%
# First, remove http elements manually
mutate(stripped_text = gsub(http,"", text)) %>%
mutate(stripped_text = gsub("germex","", text, ignore.case = T))
rt_tidy_words <- rt_clean %>%
# Second, remove punctuation, convert to lowercase, add id for each tweet!
dplyr::select(stripped_text) %>%
unnest_tokens(word, stripped_text) %>%
# Third, remove stop words from your list of words
anti_join(stopwords) %>%
# Count Word occurences in a tweet
count(word, sort = TRUE)
rt_tidy_words %>%
wordcloud2(size = 3,
color = "random-light", backgroundColor = "grey")word_network(rt_clean)Lexikon Ansatz unter Verwendung des SentimentWortschatz
sent <- c(
# positive Wörter
readLines("../../dict/SentiWS_v1.8c_Negative.txt",
encoding = "UTF-8"),
# negative Wörter
readLines("../../dict/SentiWS_v1.8c_Positive.txt",
encoding = "UTF-8")
) %>% lapply(function(x) {
# Extrahieren der einzelnen Spalten
res <- strsplit(x, "\t", fixed = TRUE)[[1]]
return(data.frame(words = res[1], value = res[2],
stringsAsFactors = FALSE))
}) %>%
bind_rows %>%
mutate(word = gsub("\\|.*", "", words) %>% tolower,
value = as.numeric(value)) %>%
# manche Wörter kommen doppelt vor, hier nehmen wir den mittleren Wert
group_by(word) %>% summarise(value = mean(value)) %>% ungroupsentDF <- rt_clean %>%
# Second, remove punctuation, convert to lowercase, add id for each tweet!
unnest_tokens(word, stripped_text) %>%
left_join(., sent, by="word") %>%
mutate(value = as.numeric(value)) %>%
#filter(!is.na(value)) %>%
mutate(negative = ifelse(value < 0, value, NA),
positive = ifelse(value > 0, value, NA),
negative_d = ifelse(value < 0, 1, 0),
positive_d = ifelse(value > 0, 1, 0)) sentDF.grouped <- sentDF %>%
group_by(status_id) %>%
summarise(mean_value = mean(value, na.rm = T),
sum_value = sum(value, na.rm = T),
positive = sum(positive, na.rm = T),
negative = sum(negative, na.rm = T)) %>%
left_join(., rt_small %>% dplyr::select(status_id, screen_name, text, created_at),
by = "status_id") %>%
filter(!is.na(mean_value))
sentDF.grouped %>%
arrange(desc(mean_value)) %>%
select(screen_name, text, mean_value, created_at) %>%
.[1:10,] %>%
htmlTable::htmlTable(align="l")| screen_name | text | mean_value | created_at | |
|---|---|---|---|---|
| 1 | Hessenfriese | @BILD Ist uns fast gelungen….. #GERMEX #WM2018 https://t.co/quDq0wTnMX | 1 | 2018-06-17 17:01:12 |
| 2 | Mastermind_09 | Draxler und Reus bislang ungefähr mit gleich vielen gelungen Ballaktionen. #GERMEX | 1 | 2018-06-17 17:22:02 |
| 3 | GmachtZumTxtn | Noch nie ist es einer Mannschaft gelungen seinen eigenen Linksverteidiger so aus dem Spiel zu nehmen #GERMEX | 1 | 2018-06-17 18:37:26 |
| 4 | nerdfromaustria | Der Sonntag wäre perfekt, wenn Deutschland eins auf die Nase kriegt… Ganz neutral gesprochen ;) #GERMEX #WM2018 | 0.7299 | 2018-06-17 16:12:47 |
| 5 | DerFilmer | That feel wenn der @BR24 Radiokommentar perfekt synchron zum @BBCSport Fernsehbild ist. #GERMEX #WM2018 | 0.7299 | 2018-06-17 17:11:25 |
| 6 | mir70 | Kimmich passt vom Sympathiefaktor perfekt zum FC Bayern … #GERMEX | 0.7299 | 2018-06-17 17:26:16 |
| 7 | nerow1909 | @Endi_AJ Wer gerade mal seinen lamborghini ausfahren will, kann das gerade perfekt tun. Auch in der kölner innenstadt. #germex | 0.7299 | 2018-06-17 17:31:51 |
| 8 | Sarpei007 | Naja. Die Taktik von Mex ist halt perfekt gegen die immergleiche Aufstellung/Taktik von uns. #GERMEX | 0.7299 | 2018-06-17 17:46:21 |
| 9 | allo_morph | Ich nutze auch perfekt die Räume. Im Schlafzimmer schlafe ich, im Wohnzimmer wohne ich, im Badezimmer dusche ich…och Menno! #GERMEX | 0.7299 | 2018-06-17 17:54:25 |
| 10 | hassanscorner | Man muss aber auch sagen, dass der Testspielgegner Saudi-Arabien die Mexikaner perfekt simuliert hat. #GERMEX | 0.7299 | 2018-06-17 17:54:43 |
sentDF.grouped %>%
arrange(mean_value) %>%
select(screen_name, text, mean_value, created_at) %>%
.[1:10,] %>%
htmlTable::htmlTable(align="l")| screen_name | text | mean_value | created_at | |
|---|---|---|---|---|
| 1 | DieMone37 | Neuer wird nicht in die Gefahr kommen einzuschlafen. #WM2018 #GERMEX | -1 | 2018-06-17 17:02:47 |
| 2 | hyouhakuhunter |
Deine Meinungsfreiheit ist in Gefahr! @fckart13 #FCKArt13 #GERMEX #WM2018 https://t.co/h8XhRv1Adu |
-1 | 2018-06-17 17:04:02 |
| 3 | sirxwastaken |
Das Internet ist in Gefahr und ihr habt nur Augen für einen Ball. Schaut wenigstens in der Halbzeit mal vorbei und informiert euch! #GERMEX #fckart13 #WM2018 #ger #mex #DieMannschaft |
-1 | 2018-06-17 17:04:22 |
| 4 | sportwetten_de |
|
-1 | 2018-06-17 17:10:31 |
| 5 | Baumbart4Z0 | Das freie Internet ist in Gefahr! #WM2018 #FCKArt13 #GERMEX https://t.co/lmKRfYI6bK | -1 | 2018-06-17 17:13:00 |
| 6 | anjaSeeBR |
Am 20/21.06 stimmt das EUparlament über Artikel 13 ab. Memes, Videos, Remixe, Parodien, Zitate sind in Gefahr #Meinungsfreiheit
Informier dich: https://t.co/KhlVEENOXh #GERMEX #WM2018 #savetheinternet #FCKArt13 #SaveOurInternet |
-1 | 2018-06-17 17:20:59 |
| 7 | Winkendekatze |
SCHAUT NICHT WEG! Das Internet ist in Gefahr! WM2018GERMEX#FCKart13 https://t.co/SLDh8eSEav |
-1 | 2018-06-17 17:22:28 |
| 8 | Jan_04 | Teilweise vogelwild - auf beiden Seiten. An sich mal ein ganz angenehmer Kontrast zum kontrollierten Fußball in der Bundesliga. Birgt aber die Gefahr, dass beim Abpfiff 80 Millionen Deutsche Boatengs Haarfarbe haben. #GERMEX #WM2018 | -1 | 2018-06-17 17:23:29 |
| 9 | marcelbuslay | Am 20. Juni 2018 wird über Artikel 13 abgestimmt. Helft mit das Zensurgesetzt zu verhindern bevor es zu spät ist. Informiere dich jetzt: https://t.co/JeRueO11zn Deine Meinungsfreiheit ist in Gefahr! #FCKArt13 #savetheinternet #saveyourinternet #GERMEX https://t.co/7a1DQSsj6h | -1 | 2018-06-17 17:25:20 |
| 10 | Kwn69943344 |
Das Internet ist in Gefahr! Informier dich! #WM2018 #GERMEX #FCKart13 https://t.co/zmDr4x4lxM https://t.co/6wbQTu4ybH |
-1 | 2018-06-17 17:28:54 |